#!/usr/bin/env LC_ALL=en_US perl
#
# This is a hack to run SLOCCOUNT and send the data back.
# it is not a finished product
#

use warnings;
use strict;

use XML::Simple;
use LWP::UserAgent;
use LWP::Simple;
use HTTP::Request::Common;
use Getopt::Long;

sub is_milestone($);
sub latest_milestone($);
sub grab_tag_list();

# pinched form cwsget
sub is_milestone($)
{
    my $name= shift;
    return 1 if ($name =~ /\w+680_m\d+/);
    return 0;
}

# pinched form cwsget
sub latest_milestone($)
{
    my $master= shift;
    my $url = 'http://go-oo.org/tinderbox/tags/tag-latest-master-list';
    
    my $response = get($url) || die "Couldn't get $url\n";
    foreach(split /\n/, $response)
    {
	unless (/\#.*/)
	{
	    (my $name, my $base, my $tag, my $dirs) = split / : /, $_;
	    return $name if $name =~ /$master/;
	}
    }
    die "couldn't find latest milestone!\n";
}

sub grab_tag_list()
{
    my $url= 'http://go-oo.org/tinderbox/tags/tag-list';
        
    my $response = get($url) || die "Couldn't get $url\n";
    my %h;
    foreach(split /\n/, $response)
    {
	unless (/\#.*/)
	{
	    (my $name, my $base, my $tag, my $dirs) = split / : /, $_;
	    
	    $h{$name}= 
	    {
		'base' => $base,
		'tag'  => $tag,
		'dirs' => [split / /, $dirs]
		};
	}
    }
    print "Got tag list from $url\n";
    return \%h;
}

sub interpret_branch($$)
{
    my $name= shift;
    my $cws_list= shift;
    my $milestone;
    my $cws= "none"; #special case

    if ($name eq 'HEAD' || $name eq '')
    {
	$milestone= latest_milestone('SRC680');
    }
    elsif(is_milestone($name))
    {
	$milestone= $name;
    }
    else
    {
	die "cws not found!!\n" unless $cws_list->{$name};
	$cws= $name;
	$milestone= $cws_list->{$name}->{'base'};
    }
    print "The milestone of the CWS $cws is $milestone\n";
    return ($milestone, $cws);
}

print "Starting to run sloccount\n\n";


my $server_url= "http://termite.go-oo.org:3000";


print "Using the server $server_url\n";

my $branch= '';
my $buildername;
my $slavename;
my $buildnumber;
my $help_option;
GetOptions('help'        => \$help_option,
	   'branch:s'    => \$branch,
	   'buildernamer:s' => \$buildername,
	   'slavename:s'    => \$slavename,
	   'buildnumber:s'  => \$buildnumber);
if ($help_option)
{
    print STDERR "This script is undocumented.  It is meant to be invoked by buildbot, and should not be run by the user\n";
    exit 1;
}


# discern cws,pws here
my $cws, my $pws;
my $milestone;
my $cws_list= grab_tag_list;
($milestone, $cws) = interpret_branch($branch, $cws_list);
if ($cws eq 'none')
{# milestones will have milestone set to tag and cws set to none   
     if ($milestone =~ /(\w+)_/)
 {
     $pws= $1;
     $cws= $milestone;
 }
}
else
{
    $pws= $milestone;
}

# run sloccount
my $sloc_output= `sloccount *`;
die "couldn't run sloccount!\n" unless $? == 0;

# parse output
my $sloc;
foreach my $line (split /\n/, $sloc_output)
{
    if ($line=~/Total Physical Source Lines of Code \(SLOC\)\s+=\s+([\d,]+)/)
    {
	$sloc= $1;
	$sloc=~ s/,//g; # there must be a more elegant way
    }
}

my $hashref= 
{
    'build' => {
	'pws' => $pws,
	'cws' => $cws,
	'builder' => $buildername,
	'host' => $slavename,
	'build_number' => $buildnumber,
	},
	    'data_item' =>
	{
	    'data_type' => 'sloccount',
	    'data' => {
		'SLOC' => $sloc
		}
	}
};

my $xml= XMLout($hashref, NoAttr => 1, RootName => 'data');
 
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
 
my $response = $ua->request(POST "$server_url/data.xml",
			    Content_Type => 'text/xml',
			    Content => $xml);
if ($response->is_success) 
{
    print $response->status_line; # b0rked    
}
else 
{
    die $response->content;  # worked!
}
print "TinderPrint: http://termite.go-oo.org/reporter/reports/1?cws=$cws \n";
print "TinderPrint: http://termite.go-oo.org/reporter/reports/2?cws=$cws \n";
print "TinderPrint: http://termite.go-oo.org/reporter/reports/3 \n";

print "Finished running sloccount\n";
